home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Languages / Masm V6.11 / SAMPLES / DEMOS / MATH.AS$ / MATH
Encoding:
Text File  |  1992-11-12  |  14.1 KB  |  335 lines
  1.         .MODEL  small, pascal, os_dos
  2.         INCLUDE demo.inc
  3.         .CODE
  4.  
  5. ;* AddLong - Adds two double-word (long) integers.
  6. ;*
  7. ;* Shows:   Instructions - add     adc
  8. ;*          Operator - PTR
  9. ;*
  10. ;* Params:  Long1 - First integer
  11. ;*          Long2 - Second integer
  12. ;*
  13. ;* Return:  Sum as long integer
  14.  
  15. AddLong PROC,
  16.         Long1:SDWORD, Long2:SDWORD
  17.  
  18.         mov     ax, WORD PTR Long1[0]   ; AX = low word, long1
  19.         mov     dx, WORD PTR Long1[2]   ; DX = high word, long1
  20.         add     ax, WORD PTR Long2[0]   ; Add low word, long2
  21.         adc     dx, WORD PTR Long2[2]   ; Add high word, long2
  22.         ret                             ; Result returned as DX:AX
  23.  
  24. AddLong ENDP
  25.  
  26. ;* SubLong - Subtracts a double-word (long) integer from another.
  27. ;*
  28. ;* Shows:   Instructions -  sub     sbb
  29. ;*
  30. ;* Params:  Long1 - First integer
  31. ;*          Long2 - Second integer
  32. ;*
  33. ;* Return:  Difference as long integer
  34.  
  35. SubLong PROC,
  36.         Long1:SDWORD, Long2:SDWORD
  37.  
  38.         mov     ax, WORD PTR Long1[0]   ; AX = low word, long1
  39.         mov     dx, WORD PTR Long1[2]   ; DX = high word, long1
  40.         sub     ax, WORD PTR Long2[0]   ; Subtract low word, long2
  41.         sbb     dx, WORD PTR Long2[2]   ; Subtract high word, long2
  42.         ret                             ; Result returned as DX:AX
  43.  
  44. SubLong ENDP
  45.  
  46.  
  47. ;* MulLong - Multiplies two unsigned double-word (long) integers. The
  48. ;* procedure allows for a product of twice the length of the multipliers,
  49. ;* thus preventing overflows. The result is copied into a 4-word data area
  50. ;* and a pointer to the data area is returned.
  51. ;*
  52. ;* Shows:   Instruction - mul
  53. ;*          Predefined equate - @data
  54. ;*
  55. ;* Params:  Long1 - First integer (multiplicand)
  56. ;*          Long2 - Second integer (multiplier)
  57. ;*
  58. ;* Return:  Pointer to quadword result
  59.  
  60.         .DATA
  61.         PUBLIC result
  62. result    QWORD     ?           ; Result from MulLong
  63.  
  64.         .CODE
  65. MulLong PROC,
  66.         Long1:DWORD, Long2:DWORD
  67.  
  68.         mov     ax, WORD PTR Long2[2]   ; Multiply long2 high word
  69.         mul     WORD PTR Long1[2]       ;   by long1 high word
  70.         mov     WORD PTR result[4], ax
  71.         mov     WORD PTR result[6], dx
  72.  
  73.         mov     ax, WORD PTR Long2[2]   ; Multiply long2 high word
  74.         mul     WORD PTR Long1[0]       ;   by long1 low word
  75.         mov     WORD PTR result[2], ax
  76.         add     WORD PTR result[4], dx
  77.         adc     WORD PTR result[6], 0   ; Add any remnant carry
  78.  
  79.         mov     ax, WORD PTR Long2[0]   ; Multiply long2 low word
  80.         mul     WORD PTR Long1[2]       ;   by long1 high word
  81.         add     WORD PTR result[2], ax
  82.         adc     WORD PTR result[4], dx
  83.         adc     WORD PTR result[6], 0   ; Add any remnant carry
  84.  
  85.         mov     ax, WORD PTR Long2[0]   ; Multiply long2 low word
  86.         mul     WORD PTR Long1[0]       ;   by long1 low word
  87.         mov     WORD PTR result[0], ax
  88.         add     WORD PTR result[2], dx
  89.         adc     WORD PTR result[4], 0   ; Add any remnant carry
  90.  
  91.         mov     ax, OFFSET result       ; Return pointer
  92.         mov     dx, @data               ;   to result
  93.         ret
  94.  
  95. MulLong ENDP
  96.  
  97.  
  98. ;* ImulLong - Multiplies two signed double-word integers. Because the imul
  99. ;* instruction (illustrated here) treats each word as a signed number, its
  100. ;* use is impractical when multiplying multiword values. Thus the technique
  101. ;* used in the MulLong procedure can't be adopted here. Instead, ImulLong
  102. ;* is broken into three sections arranged in ascending order of computational
  103. ;* overhead. The procedure tests the values of the two integers and selects
  104. ;* the section that involves the minimum required effort to multiply them.
  105. ;*
  106. ;* Shows:   Instruction - imul
  107. ;*
  108. ;* Params:  Long1 - First integer (multiplicand)
  109. ;*          Long2 - Second integer (multiplier)
  110. ;*
  111. ;* Return:  Result as long integer
  112.  
  113. ImulLong PROC USES si,
  114.         Long1:SDWORD, Long2:SDWORD
  115.  
  116. ; Section 1 tests for integers in the range of 0 to 65,535. If both
  117. ; numbers are within these limits, they're treated as unsigned short
  118. ; integers.
  119.  
  120.         mov     ax, WORD PTR Long2[0]   ; AX = low word of long2
  121.         mov     dx, WORD PTR Long2[2]   ; DX = high word of long2
  122.         mov     bx, WORD PTR Long1[0]   ; BX = low word of long1
  123.         mov     cx, WORD PTR Long1[2]   ; CX = high word of long1
  124.         .IF     (dx == 0) && (cx == 0)  ; If both high words are zero,
  125.         mul     bx                      ;   multiply the low words
  126.         jmp     exit                    ;   and exit section 1
  127.         .ENDIF
  128.  
  129. ; Section 2 tests for integers in the range of -32,768 to 32,767. If
  130. ; both numbers are within these limits, they're treated as signed short
  131. ; integers.
  132.  
  133.         push    ax                      ; Save long2 low word
  134.         push    bx                      ; Save long1 low word
  135.         or      dx, dx                  ; High word of long2 = 0?
  136.         jnz     notzhi2                 ; No?  Test for negative
  137.         test    ah, 80h                 ; Low word of long2 in range?
  138.         jz      notnlo2                 ; Yes?  long2 ok, so test long1
  139.         jmp     sect3                   ; No?  Go to section 3
  140. notzhi2:
  141.         cmp     dx, 0FFFFh              ; Empty with sign flag set?
  142.         jne     sect3                   ; No?  Go to section 3
  143.         test    ah, 80h                 ; High bit set in low word?
  144.         jz      sect3                   ; No?  Low word is too high
  145. notnlo2:
  146.         or      cx, cx                  ; High word of long1 = 0?
  147.         jnz     notzhi1                 ; No?  Test for negative
  148.         test    bh, 80h                 ; Low word of long1 in range?
  149.         jz      notnlo1                 ; Yes?  long1 ok, so use sect 2
  150.         jmp     sect3                   ; No?  Go to section 3
  151. notzhi1:
  152.         cmp     cx, 0FFFFh              ; Empty with sign flag set?
  153.         jne     sect3                   ; No?  Go to section 3
  154.         test    bh, 80h                 ; High bit set in low word?
  155.         jz      sect3                   ; No?  Low word is too high
  156. notnlo1:
  157.         imul    bx                      ; Multiply low words
  158.         pop     bx                      ; Clean stack
  159.         pop     bx
  160.         jmp     exit                    ; Exit section 2
  161.  
  162. ; Section 3 involves the most computational overhead. It treats the two
  163. ; numbers as signed long (double-word) integers.
  164.  
  165. sect3:
  166.         pop     bx                      ; Recover long1 low word
  167.         pop     ax                      ; Recover long2 low word
  168.         mov     si, dx                  ; SI = long2 high word
  169.         push    ax                      ; Save long2 low word
  170.         mul     cx                      ; long1 high word x long2 low word
  171.         mov     cx, ax                  ; Accumulate products in CX
  172.         mov     ax, bx                  ; AX = low word of long1
  173.         mul     si                      ; Multiply by long2 high word
  174.         add     cx, ax                  ; Add to previous product
  175.         pop     ax                      ; Recover long2 low word
  176.         mul     bx                      ; Multiply by long1 low word
  177.         add     dx, cx                  ; Add to product high word
  178. exit:
  179.         ret                             ; Return result as DX:AX
  180.  
  181. ImulLong ENDP
  182.  
  183.  
  184. ;* DivLong - Divides an unsigned long integer by an unsigned short integer.
  185. ;* The procedure does not check for overflow or divide-by-zero.
  186. ;*
  187. ;* Shows:   Instruction -  div
  188. ;*
  189. ;* Params:  Long1 - First integer (dividend)
  190. ;*          Short2 - Second integer (divisor)
  191. ;*          Remn - Pointer to remainder
  192. ;*
  193. ;* Return:  Quotient as short integer
  194.  
  195. DivLong PROC USES di,
  196.         Long1:DWORD, Short2:WORD, Remn:PWORD
  197.  
  198.         mov     ax, WORD PTR Long1[0]   ; AX = low word of dividend
  199.         mov     dx, WORD PTR Long1[2]   ; DX = high word of dividend
  200.         div     Short2                  ; Divide by short integer
  201.         LoadPtr es, di, Remn            ; Point ES:DI to remainder
  202.         mov     es:[di], dx             ; Copy remainder
  203.         ret                             ; Return with AX = quotient
  204.  
  205. DivLong ENDP
  206.  
  207.  
  208. ;* IdivLong - Divides a signed long integer by a signed short integer.
  209. ;* The procedure does not check for overflow or divide-by-zero.
  210. ;*
  211. ;* Shows:   Instruction - idiv
  212. ;*
  213. ;* Params:  Long1 - First integer (dividend)
  214. ;*          Short2 - Second integer (divisor)
  215. ;*          Remn - Pointer to remainder
  216. ;*
  217. ;* Return:  Quotient as short integer
  218.  
  219. IdivLong PROC USES di,
  220.         Long1:SDWORD, Short2:SWORD, Remn:PSWORD
  221.  
  222.         mov     ax, WORD PTR Long1[0]   ; AX = low word of dividend
  223.         mov     dx, WORD PTR Long1[2]   ; DX = high word of dividend
  224.         idiv    Short2                  ; Divide by short integer
  225.         LoadPtr es, di, Remn            ; ES:DI = remainder
  226.         mov     es:[di], dx             ; Copy remainder
  227.         ret                             ; Return with AX = quotient
  228.  
  229. IdivLong ENDP
  230.  
  231.  
  232. ;* Quadratic - Solves for the roots of a quadratic equation of form
  233. ;*                        A*x*x + B*x + C = 0
  234. ;* using floating-point instructions. This procedure requires either a math
  235. ;* coprocessor or emulation code.
  236. ;*
  237. ;* Shows:   Instructions - sahf     fld1     fld     fadd     fmul
  238. ;*                         fxch     fsubr    fchs    fsubp    fstp
  239. ;*                         fst      fstsw    fdivr   fwait    ftst
  240. ;*
  241. ;* Params:  a - Constant for 2nd-order term
  242. ;*          b - Constant for 1st-order term
  243. ;*          c - Equation constant
  244. ;*          R1 - Pointer to 1st root
  245. ;*          R2 - Pointer to 2nd root
  246. ;*
  247. ;* Return:  Short integer with return code
  248. ;*          0 if both roots found
  249. ;*          1 if single root (placed in R1)
  250. ;*          2 if indeterminate
  251.  
  252. Quadratic PROC USES ds di si,
  253.         aa:DWORD, bb:DWORD, cc:DWORD, r1:PDWORD, r2:PDWORD
  254.  
  255.         LOCAL status:WORD               ; Intermediate status
  256.  
  257.         LoadPtr es, di, r1              ; ES:DI points to 1st root
  258.         LoadPtr ds, si, r2              ; DS:SI points to 2nd root
  259.         sub     bx, bx                  ; Clear error code
  260.         fld1                            ; Load top of stack with 1
  261.         fadd    st, st                  ; Double it to make 2
  262.         fld     st                      ; Copy to next register
  263.         fmul    aa                      ; ST register = 2a
  264.         ftst                            ; Test current ST value
  265.         fstsw   status                  ; Copy status to local word
  266.         fwait                           ; Ensure coprocessor is done
  267.         mov     ax, status              ; Copy status into AX
  268.         sahf                            ; Load flag register
  269.         jnz     notzero                 ; If C3 set, then a = 0, in which case
  270.                                         ;   solution is x = -c / b
  271.         fld     cc                      ; Load c parameter
  272.         fchs                            ; Reverse sign
  273.         fld     bb                      ; Load b parameter
  274.         ftst                            ; Test current ST value
  275.         fstsw   status                  ; Copy status to local word
  276.         fwait                           ; Ensure coprocessor is done
  277.         mov     ax, status              ; Copy status into AX
  278.         sahf                            ; Load flag register
  279.         jz      exit2                   ; If C3 set, b = 0, in which case
  280.                                         ;   division by zero
  281.         fdiv                            ; Divide by b
  282.         fstp    DWORD PTR es:[di]       ; Copy result and pop stack
  283.         fstp    st                      ; Clean up stack
  284.         jmp     exit1                   ; Return with code = 1
  285. notzero:
  286.         fmul    st(1), st               ; ST(1) register = 4a
  287.         fxch                            ; Exchange ST and ST(1)
  288.         fmul    cc                      ; ST register = 4ac
  289.         ftst                            ; Test current ST value
  290.         fstsw   status                  ; Copy status to local word
  291.         fwait                           ; Ensure coprocessor is done
  292.         mov     ax, status              ; Copy status into AX
  293.         sahf                            ; Load flag register
  294.         jp      exit2                   ; If C2 set, 4*a*c is infinite
  295.  
  296.         fld     bb                      ; Else load b parameter
  297.         fmul    st, st                  ; Square it; ST register = b*b
  298.         fsubr                           ; ST register = b*b - 4*a*c
  299.         ftst                            ; Test current ST value
  300.         fstsw   status                  ; Copy status to local word
  301.         fwait                           ; Ensure coprocessor is done
  302.         mov     ax, status              ; Copy status into AX
  303.         sahf                            ; Load flag register
  304.         jc      exit2                   ; If C0 set, b*b < 4ac
  305.         jnz     tworoot                 ; If C3 set, b*b = 4ac, in which
  306.         inc     bx                      ;   case only 1 root so set flag
  307. tworoot:
  308.         fsqrt                           ; Get square root
  309.         fld     bb                      ; Load b parameter
  310.         fchs                            ; Reverse sign
  311.         fxch                            ; Exchange ST and ST1
  312.         fld     st                      ; Copy square root to next reg
  313.         fadd    st, st(2)               ; ST = -b + sqrt(b*b - 4*a*c)
  314.         fxch                            ; Exchange ST and ST1
  315.         fsubp   st(2), st               ; ST = -b - sqrt(b*b - 4*a*c)
  316.  
  317.         fdiv    st, st(2)               ; Divide 1st dividend by 2*a
  318.         fstp    DWORD PTR es:[di]       ; Copy result, pop stack
  319.         fdivr                           ; Divide 2nd dividend by 2*a
  320.         fstp    DWORD PTR ds:[si]       ; Copy result, pop stack
  321.         jmp     exit                    ; Return with code
  322. exit2:
  323.         inc     bx                      ; Error code = 2 for indeterminancy
  324.         fstp    st                      ; Clean stack
  325. exit1:
  326.         inc     bx                      ; Error code = 1 for single root
  327.         fstp    st                      ; Clean stack
  328. exit:
  329.         mov ax, bx
  330.         ret
  331.  
  332. Quadratic ENDP
  333.  
  334.         END
  335.